unit ActiveXTools;

interface

uses
  SysUtils,
  Windows,
  ActiveX,
  ComObj;

type
  TRegAction = (raReg, raUnreg);

procedure RegisterActiveX( FileName: string; RegAction: TRegAction );
function RegisterTypeLib( FileName: string; RegAction: TRegAction ): TGUID;

implementation

resourcestring
  SFileNotFound = 'File "%s" not found';
  SCantFindProc = '%s procedure not found in "%s"';
  SRegFail = 'Call to %s failed in "%s"';
  SLoadFail = 'Failed to load "%s"';
  SCantUnregTlb = 'The version of OLEAUT32.DLL on this machine does not ' +
    'support type library unregistration.';

type
  TRegProc = function : HResult; stdcall;
  TUnRegTlbProc = function (const libID: TGUID; wVerMajor, wVerMinor: Word;
    lcid: TLCID; syskind: TSysKind): HResult; stdcall;

const
  ProcName: array[TRegAction] of PChar = (
    'DllRegisterServer', 'DllUnregisterServer');

procedure RegisterActiveX( FileName: string; RegAction: TRegAction );
var
  RegProc: TRegProc;
  LibHandle: THandle;

procedure RegisterAxLib;
begin
  LibHandle := LoadLibrary(PChar(FileName));
  if LibHandle = 0 then raise Exception.CreateFmt(SLoadFail, [FileName]);
  try
    @RegProc := GetProcAddress(LibHandle, ProcName[RegAction]);
    if @RegProc = Nil then
      raise Exception.CreateFmt(SCantFindProc, [ProcName[RegAction],
        FileName]);
    if RegProc <> 0 then
      raise Exception.CreateFmt(SRegFail, [ProcName[RegAction], FileName]);
  finally
    FreeLibrary(LibHandle);
  end;
end;

begin
  if not FileExists(FileName) then
    raise Exception.CreateFmt(SFileNotFound, [FileName]);
  RegisterAxLib;
end;

function RegisterTypeLib( FileName: string; RegAction: TRegAction ): TGUID;
var
  RegProc: TRegProc;
  LibHandle: THandle;
  OleAutLib: THandle;
  UnRegTlbProc: TUnRegTlbProc;

procedure RegisterTLB;
var
  WFileName, DocName: WideString;
  TypeLib: ITypeLib;
  LibAttr: PTLibAttr;
  DirBuffer: array[0..MAX_PATH] of char;
begin
  if ExtractFilePath(FileName) = '' then
  begin
    GetCurrentDirectory(SizeOf(DirBuffer), DirBuffer);
    FileName := '\' + FileName;
    FileName := DirBuffer + FileName;
  end;
  if not FileExists(FileName) then
    raise Exception.CreateFmt(SFileNotFound, [FileName]);
  WFileName := FileName;
  OleCheck(LoadTypeLib(PWideChar(WFileName), TypeLib));
  OleCheck(TypeLib.GetLibAttr(LibAttr));
  try
    result := LibAttr^.Guid;
    if RegAction = raReg then
    begin
      OleCheck(TypeLib.GetDocumentation(-1, nil, nil, nil, @DocName));
      DocName := ExtractFilePath(DocName);
      OleCheck(ActiveX.RegisterTypeLib(TypeLib, PWideChar(WFileName), PWideChar(DocName)));
    end
    else begin
      OleAutLib := GetModuleHandle('OLEAUT32.DLL');
      if OleAutLib <> 0 then
        @UnRegTlbProc := GetProcAddress(OleAutLib, 'UnRegisterTypeLib');
      if @UnRegTlbProc = nil then raise Exception.Create(SCantUnregTlb);
      with LibAttr^ do
        OleCheck(UnRegTlbProc(Guid, wMajorVerNum, wMinorVerNum, LCID, SysKind));
    end;
  finally
    TypeLib.ReleaseTLibAttr(LibAttr);
  end;
end;

begin
  if not FileExists(FileName) then
    raise Exception.CreateFmt(SFileNotFound, [FileName]);
  RegisterTLB;
end;

end.
